home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / cg.lha / cg / src / GramMod.mi < prev    next >
Text File  |  1992-11-24  |  23KB  |  1,131 lines
  1. IMPLEMENTATION MODULE GramMod;
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.  
  9.  
  10.  
  11.  
  12.  
  13.  
  14.  
  15. IMPORT SYSTEM, System, IO, Tree;
  16. (* line 5 "" *)
  17.  
  18.  
  19. FROM IO        IMPORT WriteS, WriteNl;
  20. FROM Strings    IMPORT tString, ArrayToString;
  21. FROM StringMem    IMPORT WriteString;
  22. FROM Idents    IMPORT NoIdent, tIdent, MakeIdent;
  23. FROM Texts    IMPORT WriteText;
  24. FROM Sets    IMPORT IsElement, Include;
  25. FROM TreeMod2    IMPORT TreeIO;
  26.  
  27. FROM Tree    IMPORT
  28.    NoTree    , tTree        , Input        , Reverse    ,
  29.    Class    , NoClass    , Child        , Attribute    ,
  30.    ActionPart    , HasSelector    , HasAttributes    , NoCodeAttr    ,
  31.    Referenced    , Options    , TreeRoot    , QueryTree    ,
  32.    ClassCount    , iNoTree    , itTree    , Generated    ,
  33.    f        , WI, WE, WN    , ForallClasses    , ForallAttributes,
  34.    Nonterminal    , Terminal    , IdentifyAttribute,
  35.    String    , iPosition    ;
  36.  
  37. IMPORT Strings;
  38.  
  39. VAR
  40.    Node, ActClass, TheClass, TheAttr    : tTree;
  41.    iOper, iLeft, iRight, iNone, iPrec, iRule    : tIdent;
  42.    ActActionIndex, PrevActionIndex, i    : SHORTCARD;
  43.    IsImplicit                : BOOLEAN;
  44.    s                    : tString;
  45.  
  46. PROCEDURE GetBaseClass (Class: tTree): tTree;
  47.    BEGIN
  48.       WHILE Class^.Class.BaseClass^.Kind # NoClass DO
  49.      Class := Class^.Class.BaseClass;
  50.       END;
  51.       RETURN Class;
  52.    END GetBaseClass;
  53.  
  54. PROCEDURE IsLast (Class, Action: tTree): BOOLEAN;
  55.    VAR Found, Last: BOOLEAN;
  56.    BEGIN
  57.       IsLast2 (Class, Action, Found, Last);
  58.       RETURN Last;
  59.    END IsLast;
  60.  
  61. PROCEDURE IsLast2 (t, Action: tTree; VAR pFound, pLast: BOOLEAN);
  62.    VAR Found, Last: BOOLEAN;
  63.    BEGIN
  64.       CASE t^.Kind OF
  65.       | Class:
  66.         IsLast2 (t^.Class.Attributes, Action, pFound, pLast);
  67.         IF pFound OR NOT pLast THEN RETURN; END;
  68.         IsLast2 (t^.Class.BaseClass, Action, pFound, pLast);
  69.       | Child:
  70.         IsLast2 (t^.Child.Next, Action, Found, Last);
  71.         pFound := Found;
  72.         IF Found THEN
  73.            pLast := Last;
  74.         ELSE
  75.            pLast := FALSE;
  76.         END;
  77.       | Attribute:
  78.         IsLast2 (t^.Attribute.Next, Action, pFound, pLast);
  79.       | ActionPart:
  80.         IsLast2 (t^.ActionPart.Next, Action, Found, Last);
  81.         pFound := Found OR (Action = t);
  82.         IF Found THEN
  83.            pLast := Last;
  84.         ELSE
  85.            pLast := Last AND (Action = t);
  86.         END;
  87.       ELSE
  88.         pFound := FALSE;
  89.         pLast  := TRUE;
  90.       END;
  91.    END IsLast2;
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192. PROCEDURE yyAbort (yyFunction: ARRAY OF CHAR);
  193.  BEGIN
  194.   IO.WriteS (IO.StdError, 'Error: module GramMod, routine ');
  195.   IO.WriteS (IO.StdError, yyFunction);
  196.   IO.WriteS (IO.StdError, ' failed');
  197.   IO.WriteNl (IO.StdError);
  198.   Exit;
  199.  END yyAbort;
  200.  
  201. PROCEDURE yyIsEqual (yya, yyb: ARRAY OF SYSTEM.BYTE): BOOLEAN;
  202.  VAR yyi    : INTEGER;
  203.  BEGIN
  204.   FOR yyi := 0 TO INTEGER (HIGH (yya)) DO
  205.    IF yya [yyi] # yyb [yyi] THEN RETURN FALSE; END;
  206.   END;
  207.   RETURN TRUE;
  208.  END yyIsEqual;
  209.  
  210. PROCEDURE ParsSpec (t: Tree.tTree);
  211.  VAR yyTempo: RECORD CASE : INTEGER OF
  212.  END; END;
  213.  BEGIN
  214.   IF t = Tree.NoTree THEN RETURN; END;
  215.   IF (t^.Kind = Tree.Ag) THEN
  216. (* line 93 "" *)
  217.      WITH t^.Ag DO
  218. (* line 93 "" *)
  219.       
  220.     IF ScannerName # NoIdent THEN
  221.        WriteS (f, "SCANNER "); WI (ScannerName);
  222.     END;
  223.     WriteS (f, " PARSER "); WI (ParserName); WriteNl (f);
  224.     WriteS (f, "GLOBAL {"); WriteNl (f);
  225.     WriteText (f, ParserCodes^.Codes.Global);
  226.     Node := Modules;
  227.     WHILE Node^.Kind = Tree.Module DO
  228.        WriteText (f, Node^.Module.ParserCodes^.Codes.Global);
  229.        Node := Node^.Module.Next;
  230.     END;
  231.     WriteS (f, "TYPE"); WriteNl (f);
  232.         ParsVariant (Classes);
  233.     WriteNl (f);
  234.     WriteS (f, "tParsAttribute = RECORD CASE : SHORTCARD OF"); WriteNl (f);
  235.     WriteS (f, "  0: Scan: "); 
  236.     IF ScannerName # NoIdent THEN WI (ScannerName); ELSE WriteS (f, "Scanner"); END;
  237.     WriteS (f, ".tScanAttribute;"); WriteNl (f);
  238.     i := 0;
  239.     Node := Classes;
  240.     WHILE Node^.Kind = Class DO
  241.       WITH Node^.Class DO
  242.          IF {Nonterminal, Referenced, HasAttributes} <= Properties THEN
  243.            INC (i);
  244.            WriteS (f, "| "); WN (i); WriteS (f, ": "); 
  245.            IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  246.          WriteS (f, "(* "); WE (Name); WriteS (f, " *) yy"); WN (Name);
  247.          WriteS (f, ": yy"); WN (Name); WriteS (f, ";"); WriteNl (f);
  248.            ELSE
  249.          WI (Selector); WriteS (f, ": yy"); WI (Selector); WriteS (f, ";"); WriteNl (f);
  250.            END;
  251.          END;
  252.          Node := Next;
  253.       END;
  254.     END;
  255.     WriteS (f, "END; END;"); WriteNl (f);
  256.     WriteS (f, "}"); WriteNl (f);
  257.     WriteNl (f);
  258.     WriteS (f, "EXPORT {"); WriteNl (f);
  259.     WriteText (f, ParserCodes^.Codes.Export);
  260.     Node := Modules;
  261.     WHILE Node^.Kind = Tree.Module DO
  262.       WriteText (f, Node^.Module.ParserCodes^.Codes.Export);
  263.       Node := Node^.Module.Next;
  264.     END;
  265.     WriteS (f, "}"); WriteNl (f);
  266.     WriteNl (f);
  267.     WriteS (f, "LOCAL {"); WriteNl (f);
  268.     WriteText (f, ParserCodes^.Codes.Local);
  269.     Node := Modules;
  270.     WHILE Node^.Kind = Tree.Module DO
  271.       WriteText (f, Node^.Module.ParserCodes^.Codes.Local);
  272.       Node := Node^.Module.Next;
  273.     END;
  274.     WriteS (f, "}"); WriteNl (f);
  275.     WriteNl (f);
  276.     WriteS (f, "BEGIN {"); WriteNl (f);
  277.     WriteText (f, ParserCodes^.Codes.Begin);
  278.     Node := Modules;
  279.     WHILE Node^.Kind = Tree.Module DO
  280.       WriteText (f, Node^.Module.ParserCodes^.Codes.Begin);
  281.       Node := Node^.Module.Next;
  282.     END;
  283.     WriteS (f, "}"); WriteNl (f);
  284.     WriteNl (f);
  285.     WriteS (f, "CLOSE {"); WriteNl (f);
  286.     WriteText (f, ParserCodes^.Codes.Close);
  287.     Node := Modules;
  288.     WHILE Node^.Kind = Tree.Module DO
  289.       WriteText (f, Node^.Module.ParserCodes^.Codes.Close);
  290.       Node := Node^.Module.Next;
  291.     END;
  292.     WriteS (f, "}"); WriteNl (f);
  293.     WriteNl (f);
  294.     WriteS (f, "TOKEN"); WriteNl (f);
  295.     WriteNl (f);
  296.     ForallClasses (Classes, Token);
  297.     WriteNl (f);
  298.     WriteS (f, "OPER"); WriteNl (f);
  299.     WriteNl (f);
  300.     PrecDefs (Precs);
  301.     WriteNl (f);
  302.     WriteS (f, "RULE"); WriteNl (f);
  303.     WriteNl (f);
  304.     ForallClasses (Classes, ParsSpec);
  305. ;
  306.       RETURN;
  307.      END;
  308.  
  309.   END;
  310.   IF (t^.Kind = Tree.Class) THEN
  311. (* line 180 "" *)
  312.      WITH t^.Class DO
  313. (* line 180 "" *)
  314.       
  315.     IF {Nonterminal, Referenced} <= Properties THEN
  316.        TheClass := t;
  317.        Grammar (t);
  318.     END;
  319. ;
  320.       RETURN;
  321.      END;
  322.  
  323.   END;
  324.  END ParsSpec;
  325.  
  326. PROCEDURE ScanSpec (t: Tree.tTree);
  327.  VAR yyTempo: RECORD CASE : INTEGER OF
  328.  END; END;
  329.  BEGIN
  330.   IF t = Tree.NoTree THEN RETURN; END;
  331.   IF (t^.Kind = Tree.Ag) THEN
  332. (* line 190 "" *)
  333.      WITH t^.Ag DO
  334. (* line 190 "" *)
  335.       
  336.     WriteS (f, "m"); WriteNl (f);
  337.     WriteS (f, "TYPE"); WriteNl (f);
  338.     ForallClasses (Classes, ScanVariant);
  339.     WriteNl (f);
  340.     WriteS (f, "tScanAttribute = RECORD"); WriteNl (f);
  341.     WriteS (f, "Position: tPosition;"); WriteNl (f);
  342.     WriteS (f, "CASE : SHORTCARD OF"); WriteNl (f);
  343.     ForallClasses (Classes, ScanAttr);
  344.     WriteS (f, "END; END;"); WriteNl (f);
  345.     WriteNl (f);
  346.     WriteS (f, "PROCEDURE ErrorAttribute (Token: INTEGER; VAR pAttribute: tScanAttribute);"); WriteNl (f);
  347.     WriteS (f, "%%"); WriteNl (f);
  348.     WriteS (f, "PROCEDURE ErrorAttribute (Token: INTEGER; VAR pAttribute: tScanAttribute);"); WriteNl (f);
  349.     WriteS (f, "BEGIN"); WriteNl (f);
  350.     WriteS (f, " pAttribute.Position := Attribute.Position;"); WriteNl (f);
  351.     WriteS (f, " CASE Token OF"); WriteNl (f);
  352.     ForallClasses (Classes, ErrorActions);
  353.     WriteS (f, " ELSE"); WriteNl (f);
  354.     WriteS (f, " END;"); WriteNl (f);
  355.     WriteS (f, "END ErrorAttribute;"); WriteNl (f);
  356.     WriteS (f, "%%"); WriteNl (f);
  357.     ForallClasses (Classes, ScanSpec);
  358. ;
  359.       RETURN;
  360.      END;
  361.  
  362.   END;
  363.   IF (t^.Kind = Tree.Class) THEN
  364. (* line 214 "" *)
  365.      WITH t^.Class DO
  366. (* line 214 "" *)
  367.       
  368.     IF {Terminal, Referenced} <= Properties THEN
  369.        WN (Code);
  370.        IF HasAttributes IN Properties THEN    WriteS (f, " S "); 
  371.        ELSE                    WriteS (f, " N "); 
  372.        END;
  373.        IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  374.           WriteS (f, "yy"); WN (Code);
  375.        ELSE
  376.           WI (Selector);
  377.        END;
  378.        WriteS (f, " "); WI (Name); WriteNl (f);
  379.     END;
  380. ;
  381.       RETURN;
  382.      END;
  383.  
  384.   END;
  385.  END ScanSpec;
  386.  
  387. PROCEDURE ErrorActions (t: Tree.tTree);
  388.  VAR yyTempo: RECORD CASE : INTEGER OF
  389.  END; END;
  390.  BEGIN
  391.   IF t = Tree.NoTree THEN RETURN; END;
  392.  
  393.   CASE t^.Kind OF
  394.   | Tree.Class:
  395. (* line 232 "" *)
  396.      WITH t^.Class DO
  397. (* line 232 "" *)
  398.       
  399.     IF {Terminal, Referenced, HasAttributes} <= Properties THEN
  400.       WriteS (f, " | (* "); WE (Name); WriteS (f, " *) "); WN (Code); WriteS (f, ": "); WriteNl (f);
  401.       TheClass := t;
  402.       ForallAttributes (t, ErrorActions);
  403.     END;
  404. ;
  405.       RETURN;
  406.      END;
  407.  
  408.   | Tree.ActionPart:
  409. (* line 239 "" *)
  410.      WITH t^.ActionPart DO
  411. (* line 239 "" *)
  412.       
  413.     ErrorActions (Actions);
  414. ;
  415.       RETURN;
  416.      END;
  417.  
  418.   | Tree.Assign:
  419. (* line 242 "" *)
  420.      WITH t^.Assign DO
  421. (* line 242 "" *)
  422.       
  423.     ErrorActions (Results); WriteS (f, ":="); ErrorActions (Arguments); WriteS (f, ";"); WriteNl (f);
  424.     ErrorActions (Next);
  425. ;
  426.       RETURN;
  427.      END;
  428.  
  429.   | Tree.Copy:
  430. (* line 246 "" *)
  431.      WITH t^.Copy DO
  432. (* line 246 "" *)
  433.       
  434.     ErrorActions (Results); WriteS (f, " := "); ErrorActions (Arguments); WriteS (f, ";"); WriteNl (f);
  435.     ErrorActions (Next);
  436. ;
  437.       RETURN;
  438.      END;
  439.  
  440.   | Tree.TargetCode:
  441. (* line 250 "" *)
  442.      WITH t^.TargetCode DO
  443. (* line 250 "" *)
  444.       
  445.     ErrorActions (Code); WriteS (f, ";"); WriteNl (f);
  446.     ErrorActions (Next);
  447. ;
  448.       RETURN;
  449.      END;
  450.  
  451.   | Tree.Order:
  452. (* line 254 "" *)
  453.      WITH t^.Order DO
  454. (* line 254 "" *)
  455.       
  456.     ErrorActions (Next);
  457. ;
  458.       RETURN;
  459.      END;
  460.  
  461.   | Tree.Check:
  462. (* line 257 "" *)
  463.      WITH t^.Check DO
  464. (* line 257 "" *)
  465.       
  466.     IF Statement # NoTree THEN
  467.        IF Condition # NoTree THEN
  468.           WriteS (f, "IF NOT ("); ErrorActions (Condition); WriteS (f, ") THEN "); ErrorActions (Statement); WriteS (f, "; END;"); WriteNl (f);
  469.        ELSE
  470.           ErrorActions (Statement); WriteS (f, ";"); WriteNl (f);
  471.        END;
  472.     ELSE
  473.        WriteS (f, "IF "); ErrorActions (Condition); WriteS (f, " THEN END;"); WriteNl (f);
  474.     END;
  475.     ErrorActions (Next);
  476. ;
  477.       RETURN;
  478.      END;
  479.  
  480.   | Tree.Designator:
  481. (* line 269 "" *)
  482.      WITH t^.Designator DO
  483. (* line 269 "" *)
  484.       
  485.     WI (Selector); WriteS (f, ":"); WI (Attribute);
  486.     ErrorActions (Next);
  487. ;
  488.       RETURN;
  489.      END;
  490.  
  491.   | Tree.Ident:
  492. (* line 273 "" *)
  493.      WITH t^.Ident DO
  494. (* line 273 "" *)
  495.       
  496.     TheAttr := IdentifyAttribute (TheClass, Attribute);
  497.     IF TheAttr # NoTree THEN
  498.        WriteS (f, "pAttribute"); 
  499.        IF Attribute = iPosition THEN
  500.            ELSIF (String IN TheClass^.Class.Properties) AND NOT (HasSelector IN TheClass^.Class.Properties) THEN
  501.           WriteS (f, ".yy"); WN (TheClass^.Class.Code);
  502.        ELSE
  503.           WriteS (f, "."); WI (TheClass^.Class.Selector);
  504.        END;
  505.        WriteS (f, "."); 
  506.     END;
  507.     WI (Attribute);
  508.     ErrorActions (Next);
  509. ;
  510.       RETURN;
  511.      END;
  512.  
  513.   | Tree.Any:
  514. (* line 288 "" *)
  515.      WITH t^.Any DO
  516. (* line 288 "" *)
  517.       
  518.     WriteString (f, Code);
  519.     ErrorActions (Next);
  520. ;
  521.       RETURN;
  522.      END;
  523.  
  524.   | Tree.Anys:
  525. (* line 292 "" *)
  526.      WITH t^.Anys DO
  527. (* line 292 "" *)
  528.       
  529.     ErrorActions (Layouts);
  530.     ErrorActions (Next);
  531. ;
  532.       RETURN;
  533.      END;
  534.  
  535.   | Tree.LayoutAny:
  536. (* line 296 "" *)
  537.      WITH t^.LayoutAny DO
  538. (* line 296 "" *)
  539.       
  540.     WriteString (f, Code);
  541.     ErrorActions (Next);
  542. ;
  543.       RETURN;
  544.      END;
  545.  
  546.   ELSE END;
  547.  
  548.  END ErrorActions;
  549.  
  550. PROCEDURE ScanVariant (t: Tree.tTree);
  551.  VAR yyTempo: RECORD CASE : INTEGER OF
  552.  END; END;
  553.  BEGIN
  554.   IF t = Tree.NoTree THEN RETURN; END;
  555.   IF (t^.Kind = Tree.Class) THEN
  556. (* line 304 "" *)
  557.      WITH t^.Class DO
  558. (* line 304 "" *)
  559.       
  560.     IF {Terminal, Referenced, HasAttributes} <= Properties THEN
  561.           IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  562.         WriteS (f, "(* "); WE (Name); WriteS (f, " *) yy"); WN (Code); WriteS (f, " = RECORD "); 
  563.       ELSE
  564.         WriteS (f, "yy"); WI (Selector); WriteS (f, " = RECORD "); 
  565.       END;
  566.       TheClass := t;
  567.       ForallAttributes (t, RecordField);
  568.       WriteS (f, "END;"); WriteNl (f);
  569.     END;
  570. ;
  571.       RETURN;
  572.      END;
  573.  
  574.   END;
  575.  END ScanVariant;
  576.  
  577. PROCEDURE ScanAttr (t: Tree.tTree);
  578.  VAR yyTempo: RECORD CASE : INTEGER OF
  579.  END; END;
  580.  BEGIN
  581.   IF t = Tree.NoTree THEN RETURN; END;
  582.   IF (t^.Kind = Tree.Class) THEN
  583. (* line 320 "" *)
  584.      WITH t^.Class DO
  585. (* line 320 "" *)
  586.       
  587.     IF {Terminal, Referenced, HasAttributes} <= Properties THEN
  588.       WriteS (f, "| "); WN (Code); WriteS (f, ": "); 
  589.           IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  590.         WriteS (f, "(* "); WE (Name); WriteS (f, " *) yy"); WN (Code); WriteS (f, ": yy"); WN (Code); WriteS (f, ";"); WriteNl (f);
  591.       ELSE
  592.         WI (Selector); WriteS (f, ": yy"); WI (Selector); WriteS (f, ";"); WriteNl (f);
  593.       END;
  594.     END;
  595. ;
  596.       RETURN;
  597.      END;
  598.  
  599.   END;
  600.  END ScanAttr;
  601.  
  602. PROCEDURE ParsVariant (t: Tree.tTree);
  603.  VAR yyTempo: RECORD CASE : INTEGER OF
  604.  END; END;
  605.  BEGIN
  606.   IF t = Tree.NoTree THEN RETURN; END;
  607.   IF (t^.Kind = Tree.Class) THEN
  608. (* line 334 "" *)
  609.      WITH t^.Class DO
  610. (* line 334 "" *)
  611.       
  612.     IF {Nonterminal, Referenced, HasAttributes} <= Properties THEN
  613.           IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  614.         WriteS (f, "(* "); WE (Name); WriteS (f, " *) yy"); WN (Name); WriteS (f, " = RECORD "); 
  615.       ELSE
  616.         WriteS (f, "yy"); WI (Selector); WriteS (f, " = RECORD "); 
  617.       END;
  618.       TheClass := t;
  619.       ForallAttributes (Attributes, RecordField);
  620.       GenExt (Extensions);
  621.       WriteS (f, "END;"); WriteNl (f);
  622.     END;
  623.     ParsVariant (Next);
  624. ;
  625.       RETURN;
  626.      END;
  627.  
  628.   END;
  629.  END ParsVariant;
  630.  
  631. PROCEDURE GenExt (t: Tree.tTree);
  632.  VAR yyTempo: RECORD CASE : INTEGER OF
  633.  END; END;
  634.  BEGIN
  635.   IF t = Tree.NoTree THEN RETURN; END;
  636.   IF (t^.Kind = Tree.Class) THEN
  637. (* line 352 "" *)
  638.      WITH t^.Class DO
  639. (* line 352 "" *)
  640.       
  641.     ForallAttributes (Attributes, RecordField);
  642.     GenExt (Extensions);
  643.     GenExt (Next);
  644. ;
  645.       RETURN;
  646.      END;
  647.  
  648.   END;
  649.  END GenExt;
  650.  
  651. PROCEDURE Token (t: Tree.tTree);
  652.  VAR yyTempo: RECORD CASE : INTEGER OF
  653.  END; END;
  654.  BEGIN
  655.   IF t = Tree.NoTree THEN RETURN; END;
  656.   IF (t^.Kind = Tree.Class) THEN
  657. (* line 361 "" *)
  658.      WITH t^.Class DO
  659. (* line 361 "" *)
  660.       
  661.     IF {Terminal, Referenced} <= Properties THEN
  662.        WriteName (Name); WriteS (f, " = "); WN (Code); WriteNl (f);
  663.     END;
  664. ;
  665.       RETURN;
  666.      END;
  667.  
  668.   END;
  669.  END Token;
  670.  
  671. PROCEDURE RecordField (t: Tree.tTree);
  672.  VAR yyTempo: RECORD CASE : INTEGER OF
  673.  END; END;
  674.  BEGIN
  675.   IF t = Tree.NoTree THEN RETURN; END;
  676.   IF (t^.Kind = Tree.Attribute) THEN
  677. (* line 370 "" *)
  678.      WITH t^.Attribute DO
  679. (* line 370 "" *)
  680.       
  681.     IF (NoCodeAttr * Properties) = {} THEN 
  682.        IF (Nonterminal IN TheClass^.Class.Properties) OR (Name # iPosition) THEN
  683.           WI (Name); WriteS (f, ": "); WI (Type); WriteS (f, "; "); 
  684.        END;
  685.     END;
  686. ;
  687.       RETURN;
  688.      END;
  689.  
  690.   END;
  691.  END RecordField;
  692.  
  693. PROCEDURE PrecDefs (t: Tree.tTree);
  694.  VAR yyTempo: RECORD CASE : INTEGER OF
  695.  END; END;
  696.  BEGIN
  697.   IF t = Tree.NoTree THEN RETURN; END;
  698.   IF (t^.Kind = Tree.LeftAssoc) THEN
  699. (* line 381 "" *)
  700.      WITH t^.LeftAssoc DO
  701. (* line 381 "" *)
  702.       
  703.     WriteS (f, "LEFT "); PrecDefs (Names); WriteNl (f);
  704.     PrecDefs (Next);
  705. ;
  706.       RETURN;
  707.      END;
  708.  
  709.   END;
  710.   IF (t^.Kind = Tree.RightAssoc) THEN
  711. (* line 385 "" *)
  712.      WITH t^.RightAssoc DO
  713. (* line 385 "" *)
  714.       
  715.     WriteS (f, "RIGHT"); PrecDefs (Names); WriteNl (f);
  716.     PrecDefs (Next);
  717. ;
  718.       RETURN;
  719.      END;
  720.  
  721.   END;
  722.   IF (t^.Kind = Tree.NonAssoc) THEN
  723. (* line 389 "" *)
  724.      WITH t^.NonAssoc DO
  725. (* line 389 "" *)
  726.       
  727.     WriteS (f, "NONE "); PrecDefs (Names); WriteNl (f);
  728.     PrecDefs (Next);
  729. ;
  730.       RETURN;
  731.      END;
  732.  
  733.   END;
  734.   IF (t^.Kind = Tree.Name) THEN
  735. (* line 393 "" *)
  736.      WITH t^.Name DO
  737. (* line 393 "" *)
  738.       
  739.     WriteS (f, " "); WI (Name);
  740.     PrecDefs (Next);
  741. ;
  742.       RETURN;
  743.      END;
  744.  
  745.   END;
  746.  END PrecDefs;
  747.  
  748. PROCEDURE Grammar (t: Tree.tTree);
  749.  VAR yyTempo: RECORD CASE : INTEGER OF
  750.  END; END;
  751.  BEGIN
  752.   IF t = Tree.NoTree THEN RETURN; END;
  753.   IF (t^.Kind = Tree.Class) THEN
  754. (* line 401 "" *)
  755.      WITH t^.Class DO
  756. (* line 401 "" *)
  757.       
  758.     IF Extensions^.Kind = Tree.NoClass THEN        (* Low ? *)
  759.        WITH TheClass^.Class DO
  760.           IF String IN Properties THEN WriteS (f, "yy"); WN (Name); ELSE WriteName (Name); END;
  761.        END;
  762.        WriteS (f, " : "); 
  763.        ActClass := t;
  764.        PrevActionIndex := 0;
  765.        IsImplicit := FALSE;
  766.        ForallAttributes (t, Rule);
  767.        IF Prec # NoIdent THEN WriteS (f, "PREC "); WI (Prec); WriteS (f, " "); END;
  768.        WriteS (f, "."); WriteNl (f);
  769.        PrevActionIndex := 0;
  770.        IsImplicit := TRUE;
  771.        ForallAttributes (t, Implicit);
  772.     ELSE
  773.        Rule (Extensions);
  774.     END;
  775. ;
  776.       RETURN;
  777.      END;
  778.  
  779.   END;
  780.  END Grammar;
  781.  
  782. PROCEDURE Rule (t: Tree.tTree);
  783.  VAR yyTempo: RECORD CASE : INTEGER OF
  784.  END; END;
  785.  BEGIN
  786.   IF t = Tree.NoTree THEN RETURN; END;
  787.  
  788.   CASE t^.Kind OF
  789.   | Tree.Class:
  790. (* line 424 "" *)
  791.      WITH t^.Class DO
  792. (* line 424 "" *)
  793.       
  794.     Grammar (t);
  795.     Rule (Next);
  796. ;
  797.       RETURN;
  798.      END;
  799.  
  800.   | Tree.Child:
  801. (* line 428 "" *)
  802.      WITH t^.Child DO
  803. (* line 428 "" *)
  804.       
  805.     IF {String, Nonterminal} <= Class^.Class.Properties THEN WriteS (f, "yy"); WN (Type); ELSE WriteName (Type); END; WriteS (f, " "); 
  806. ;
  807.       RETURN;
  808.      END;
  809.  
  810.   | Tree.ActionPart:
  811. (* line 431 "" *)
  812.      WITH t^.ActionPart DO
  813. (* line 431 "" *)
  814.       
  815.     IF IsLast (ActClass, t) THEN
  816.        WriteS (f, "{"); 
  817.        IF PrevActionIndex # 0 THEN
  818.           Node := GetBaseClass (TheClass);
  819.           WITH Node^.Class DO
  820.          IF HasAttributes IN Properties THEN
  821.             WriteS (f, " $$."); 
  822.             IF String IN Properties THEN WriteS (f, "yy"); WN (Name); ELSE WI (Name); END;
  823.             WriteS (f, " := $"); WN (PrevActionIndex); WriteS (f, "."); 
  824.             IF String IN Properties THEN WriteS (f, "yy"); WN (Name); ELSE WI (Name); END;
  825.             WriteS (f, ";"); WriteNl (f);
  826.          END;
  827.           END;
  828.        END;
  829.        Rule (Actions);
  830.        WriteS (f, "} "); 
  831.     ELSE
  832.        WriteS (f, "xx"); WN (Name); WriteS (f, " "); 
  833.     END;
  834.     PrevActionIndex := ParsIndex;
  835. ;
  836.       RETURN;
  837.      END;
  838.  
  839.   | Tree.Assign:
  840. (* line 453 "" *)
  841.      WITH t^.Assign DO
  842. (* line 453 "" *)
  843.       
  844.     Rule (Results); WriteS (f, ":="); Rule (Arguments); WriteS (f, ";"); WriteNl (f);
  845.     Rule (Next);
  846. ;
  847.       RETURN;
  848.      END;
  849.  
  850.   | Tree.Copy:
  851. (* line 457 "" *)
  852.      WITH t^.Copy DO
  853. (* line 457 "" *)
  854.       
  855.     Rule (Results); WriteS (f, " := "); Rule (Arguments); WriteS (f, ";"); WriteNl (f);
  856.     Rule (Next);
  857. ;
  858.       RETURN;
  859.      END;
  860.  
  861.   | Tree.TargetCode:
  862. (* line 461 "" *)
  863.      WITH t^.TargetCode DO
  864. (* line 461 "" *)
  865.       
  866.     Rule (Code); WriteS (f, ";"); WriteNl (f);
  867.     Rule (Next);
  868. ;
  869.       RETURN;
  870.      END;
  871.  
  872.   | Tree.Order:
  873. (* line 465 "" *)
  874.      WITH t^.Order DO
  875. (* line 465 "" *)
  876.       
  877.     Rule (Next);
  878. ;
  879.       RETURN;
  880.      END;
  881.  
  882.   | Tree.Check:
  883. (* line 468 "" *)
  884.      WITH t^.Check DO
  885. (* line 468 "" *)
  886.       
  887.     IF Statement # NoTree THEN
  888.        IF Condition # NoTree THEN
  889.           WriteS (f, "IF NOT ("); Rule (Condition); WriteS (f, ") THEN "); Rule (Statement); WriteS (f, "; END;"); WriteNl (f);
  890.        ELSE
  891.           Rule (Statement); WriteS (f, ";"); WriteNl (f);
  892.        END;
  893.     ELSE
  894.        WriteS (f, "IF "); Rule (Condition); WriteS (f, " THEN END;"); WriteNl (f);
  895.     END;
  896.     Rule (Next);
  897. ;
  898.       RETURN;
  899.      END;
  900.  
  901.   | Tree.Designator:
  902. (* line 480 "" *)
  903.      WITH t^.Designator DO
  904. (* line 480 "" *)
  905.       
  906.     TheAttr := IdentifyAttribute (ActClass, Selector);
  907.     IF TheAttr # NoTree THEN
  908.       Node := TheAttr^.Child.Class;
  909.       IF Node # NoTree THEN
  910.         WriteS (f, "$"); 
  911.         IF NOT IsImplicit THEN
  912.            WN (TheAttr^.Child.ParsIndex);
  913.         ELSE
  914.            WN (SHORTINT (TheAttr^.Child.ParsIndex + 1 - ActActionIndex));
  915.         END;
  916.         IF Nonterminal IN Node^.Class.Properties THEN    (* nonterminal *)
  917.           Node := GetBaseClass (Node);
  918.           IF (String IN Node^.Class.Properties) AND NOT (HasSelector IN Node^.Class.Properties) THEN
  919.             WriteS (f, ".yy"); WN (Node^.Class.Name);
  920.           ELSE
  921.             WriteS (f, "."); WI (Node^.Class.Name);
  922.           END;
  923.         ELSE                        (* terminal *)
  924.           WriteS (f, ".Scan"); 
  925.           IF Attribute = iPosition THEN
  926.           ELSIF (String IN Node^.Class.Properties) AND NOT (HasSelector IN Node^.Class.Properties) THEN
  927.             WriteS (f, ".yy"); WN (Node^.Class.Code);
  928.           ELSE
  929.             WriteS (f, "."); WI (Node^.Class.Selector);
  930.           END;
  931.         END;
  932.         WriteS (f, "."); WI (Attribute);
  933.       ELSE
  934.         WI (Selector); WriteS (f, ":"); WI (Attribute);
  935.       END;
  936.     ELSE
  937.       WI (Selector); WriteS (f, ":"); WI (Attribute);
  938.     END;
  939.     Rule (Next);
  940. ;
  941.       RETURN;
  942.      END;
  943.  
  944.   | Tree.Ident:
  945. (* line 516 "" *)
  946.      WITH t^.Ident DO
  947. (* line 516 "" *)
  948.       
  949.     TheAttr := IdentifyAttribute (ActClass, Attribute);
  950.     Node := GetBaseClass (TheClass);
  951.     IF TheAttr # NoTree THEN
  952.       IF (String IN Node^.Class.Properties) AND NOT (HasSelector IN Node^.Class.Properties) THEN
  953.         WriteS (f, "$$.yy"); WN (Node^.Class.Name); WriteS (f, "."); WI (Attribute);
  954.       ELSE
  955.         WriteS (f, "$$."); WI (Node^.Class.Name); WriteS (f, "."); WI (Attribute);
  956.       END;
  957.     ELSE
  958.       WI (Attribute);
  959.     END;
  960.     Rule (Next);
  961. ;
  962.       RETURN;
  963.      END;
  964.  
  965.   | Tree.Any:
  966. (* line 530 "" *)
  967.      WITH t^.Any DO
  968. (* line 530 "" *)
  969.       
  970.     WriteString (f, Code);
  971.     Rule (Next);
  972. ;
  973.       RETURN;
  974.      END;
  975.  
  976.   | Tree.Anys:
  977. (* line 534 "" *)
  978.      WITH t^.Anys DO
  979. (* line 534 "" *)
  980.       
  981.     Rule (Layouts);
  982.     Rule (Next);
  983. ;
  984.       RETURN;
  985.      END;
  986.  
  987.   | Tree.LayoutAny:
  988. (* line 538 "" *)
  989.      WITH t^.LayoutAny DO
  990. (* line 538 "" *)
  991.       
  992.     WriteString (f, Code);
  993.     Rule (Next);
  994. ;
  995.       RETURN;
  996.      END;
  997.  
  998.   ELSE END;
  999.  
  1000.  END Rule;
  1001.  
  1002. PROCEDURE Implicit (t: Tree.tTree);
  1003.  VAR yyTempo: RECORD CASE : INTEGER OF
  1004.  END; END;
  1005.  BEGIN
  1006.   IF t = Tree.NoTree THEN RETURN; END;
  1007.   IF (t^.Kind = Tree.ActionPart) THEN
  1008. (* line 546 "" *)
  1009.      WITH t^.ActionPart DO
  1010. (* line 546 "" *)
  1011.       
  1012.     IF NOT (Generated IN Properties) AND NOT IsLast (ActClass, t) THEN
  1013.        INCL (Properties, Generated);
  1014.        ActActionIndex := ParsIndex;
  1015.        WriteS (f, "xx"); WN (Name); WriteS (f, " : {"); 
  1016.        IF PrevActionIndex # 0 THEN
  1017.           Node := GetBaseClass (TheClass);
  1018.           WITH Node^.Class DO
  1019.          IF HasAttributes IN Properties THEN
  1020.             WriteS (f, " $$."); 
  1021.             IF String IN Properties THEN WriteS (f, "yy"); WN (Name); ELSE WI (Name); END;
  1022.             WriteS (f, " := $"); WN (SHORTINT (PrevActionIndex + 1 - ActActionIndex)); WriteS (f, "."); 
  1023.             IF String IN Properties THEN WriteS (f, "yy"); WN (Name); ELSE WI (Name); END;
  1024.             WriteS (f, ";"); WriteNl (f);
  1025.          END;
  1026.           END;
  1027.        END;
  1028.        Rule (Actions);
  1029.        WriteS (f, "} ."); WriteNl (f);
  1030.     END;
  1031.     PrevActionIndex := ParsIndex;
  1032. ;
  1033.       RETURN;
  1034.      END;
  1035.  
  1036.   END;
  1037.  END Implicit;
  1038.  
  1039. PROCEDURE WriteName (Name: tIdent);
  1040.  VAR yyTempo: RECORD CASE : INTEGER OF
  1041.  END; END;
  1042.  BEGIN
  1043.   IF (Name =  (iOper)) THEN
  1044. (* line 571 "" *)
  1045. (* line 576 "" *)
  1046.       WriteS (f, "\");
  1047. (* line 576 "" *)
  1048.       WI (Name);
  1049.       RETURN;
  1050.  
  1051.   END;
  1052.   IF (Name =  (iLeft)) THEN
  1053. (* line 571 "" *)
  1054. (* line 576 "" *)
  1055.       WriteS (f, "\");
  1056. (* line 576 "" *)
  1057.       WI (Name);
  1058.       RETURN;
  1059.  
  1060.   END;
  1061.   IF (Name =  (iRight)) THEN
  1062. (* line 571 "" *)
  1063. (* line 576 "" *)
  1064.       WriteS (f, "\");
  1065. (* line 576 "" *)
  1066.       WI (Name);
  1067.       RETURN;
  1068.  
  1069.   END;
  1070.   IF (Name =  (iNone)) THEN
  1071. (* line 571 "" *)
  1072. (* line 576 "" *)
  1073.       WriteS (f, "\");
  1074. (* line 576 "" *)
  1075.       WI (Name);
  1076.       RETURN;
  1077.  
  1078.   END;
  1079.   IF (Name =  (iPrec)) THEN
  1080. (* line 571 "" *)
  1081. (* line 576 "" *)
  1082.       WriteS (f, "\");
  1083. (* line 576 "" *)
  1084.       WI (Name);
  1085.       RETURN;
  1086.  
  1087.   END;
  1088.   IF (Name =  (iRule)) THEN
  1089. (* line 571 "" *)
  1090. (* line 576 "" *)
  1091.       WriteS (f, "\");
  1092. (* line 576 "" *)
  1093.       WI (Name);
  1094.       RETURN;
  1095.  
  1096.   END;
  1097. (* line 577 "" *)
  1098. (* line 577 "" *)
  1099.       WI (Name);
  1100.       RETURN;
  1101.  
  1102.  END WriteName;
  1103.  
  1104. PROCEDURE BeginGramMod;
  1105.  BEGIN
  1106. (* line 82 "" *)
  1107.  
  1108.    ArrayToString ("OPER"    , s); iOper    := MakeIdent (s);
  1109.    ArrayToString ("RIGHT"    , s); iRight    := MakeIdent (s);
  1110.    ArrayToString ("LEFT"    , s); iLeft    := MakeIdent (s);
  1111.    ArrayToString ("NONE"    , s); iNone    := MakeIdent (s);
  1112.    ArrayToString ("PREC"    , s); iPrec    := MakeIdent (s);
  1113.    ArrayToString ("RULE"    , s); iRule    := MakeIdent (s);
  1114.  
  1115.  END BeginGramMod;
  1116.  
  1117. PROCEDURE CloseGramMod;
  1118.  BEGIN
  1119.  END CloseGramMod;
  1120.  
  1121. PROCEDURE yyExit;
  1122.  BEGIN
  1123.   IO.CloseIO; System.Exit (1);
  1124.  END yyExit;
  1125.  
  1126. BEGIN
  1127.  yyf    := IO.StdOutput;
  1128.  Exit    := yyExit;
  1129.  BeginGramMod;
  1130. END GramMod.
  1131.